#!/usr/bin/perl

######################################################################
package Swignition::GenericParser::DocModel;
######################################################################

use strict;
use Swignition::GenericParser::Utils;
use Swignition::RDFModel::Subject;
use Swignition::RDFModel::Value;
use XML::LibXML;

sub is_enabled
{
	my $this = shift;
	return $this->{options}->{p_structure};
}

sub consume
{
	my $page    = shift;

	my $context = {
		current_outlinee => undef,
		current_section  => undef,
		stack            => [],
		outlines         => {},
		page             => $page
	};
	
	my @roots = $page->{DOM}->getElementsByTagName('html');
	my $root  = $roots[0];
	
	return unless ($root);
	
	my $node = $root;
	my $r;
	START: while ($node)
	{
		$r = tag('start', $node, $context);
		if ($node->firstChild)
		{
			$node = $node->firstChild;
			next START;
		}
		while ($node)
		{
			$r = tag('end', $node, $context);
			last START if ($r<0);
			if ($node->nextSibling)
			{
				$node = $node->nextSibling;
				next START;
			}
			if ($node == $root)
				{ $node = undef; }
			else
				{ $node = $node->parentNode; }
		}
	}

	$context->{primary_outlinee} = k($context->{current_outlinee});
	$context->{primary_outline}  = $context->{outlines}->{$context->{primary_outlinee}};
	
	$page->{Outlines} = $context;
	
	context_to_rdf($page, $context);
}

sub tag
{
	my $type    = shift;
	my $node    = shift;
	my $context = shift;
	
	my $top_of_stack;
	if ($context->{stack})
			{ $top_of_stack = $context->{stack}->[-1]; }
	
	# If the top of the stack is an element, and you are exiting that element
	if ($type eq 'end' && $top_of_stack && (k($top_of_stack) eq k($node)))
	{
		# Note: The element being exited is a heading content element.
		warn("This element should be a heading content element!\n")
			unless ( is_heading_content($node, $context->{page}) );
		
		# Pop that element from the stack.
		pop @{ $context->{stack} };
	}
	
	# If the top of the stack is a heading content element
	elsif ( $top_of_stack && is_heading_content($top_of_stack, $context->{page}) )
	{
		# Do nothing.
	}
	
	# When entering a sectioning content element or a sectioning root element
	elsif ($type eq 'start' && (is_sectioning_content($node, $context->{page})||is_sectioning_root($node, $context->{page})))
	{
		# If current outlinee is not null, push current outlinee onto the stack.
		push @{ $context->{stack} }, $context->{current_outlinee}
			if (defined $context->{current_outlinee});
		
		# Let current outlinee be the element that is being entered.
		$context->{current_outlinee} = $node;
		
		# Let current section be a newly created section for the current outlinee
		#     element.
		$context->{current_section} = {
			thing    => 'section',
			header   => undef,
			parent   => undef,
			elements => []
		};
		
		# Let there be a new outline for the new current outlinee, initialized
		#     with just the new current section as the only section in the
		#     outline.
		$context->{outlines}->{ k($context->{current_outlinee}) } = {
			thing    => 'outline',
			parent   => undef,
			sections => [$context->{current_section}],
			element  => $context->{current_outlinee},
			tagname  => $context->{current_outlinee}->tagName,
		};
	}
	
	# When exiting a sectioning content element, if the stack is not empty
	elsif ($type eq 'end' && $top_of_stack && is_sectioning_content($node, $context->{page}))
	{
		# Pop the top element from the stack, and let the current outlinee be
		#     that element.
		$context->{current_outlinee} = pop @{ $context->{stack} };
		
		# Let current section be the last section in the outline of the current
		#     outlinee element.
		my $ootco = $context->{outlines}->{ k($context->{current_outlinee}) };
		$context->{current_section} = $ootco->{sections}->[-1]
			if (defined $ootco->{sections}->[-1]);
			
		# Append the outline of the sectioning content element being exited to
		#     the current section. (This does not change which section is the
		#     last section in the outline.)
		push @{ $context->{current_section}->{outlines} },
			$context->{outlines}->{ k($node) };
	}
	
	# When exiting a sectioning root element, if the stack is not empty
	elsif ($type eq 'end' && $top_of_stack && is_sectioning_root($node, $context->{page}))
	{
		# TOBY: Retain relationship with other outlines
		#push @{ $context->{current_section}->{outlines} },
		#	$context->{nested_outlines}->{ $top_of_stack };
		
		# Pop the top element from the stack, and let the current outlinee be
		#     that element.
		$context->{current_outlinee} = pop @{ $context->{stack} };
		
		# Let current section be the last section in the outline of the current
		#     outlinee element.
		$context->{current_section} =
			$context->{outlines}->{ k($context->{current_outlinee}) }->{sections}->[-1];
		
		# Finding the deepest child: If current section has no child sections,
		#    stop these steps.
		FINDING_DEEPEST_CHILD: while ($context->{current_section}->{sections}->[0])
		{
			# Let current section be the last child section of the current 'current
			#     section'.
			$context->{current_section} = $context->{current_section}->{sections}->[-1];
		}
	}

	# When exiting a sectioning content element or a sectioning root element	
	elsif ($type eq 'end' && (is_sectioning_content($node, $context->{page})||is_sectioning_root($node, $context->{page})))
	{
		# Note: The current outlinee is the element being exited.
		warn("The current outlinee seems to be wrong.\n")
			unless (k($context->{current_outlinee}) eq k($node));
			
		# Let current section be the first section in the outline of the current
		#     outlinee element.
		$context->{current_section} =
			$context->{outlines}->{ k($context->{current_outlinee}) }->{sections}->[0];
			
		# Skip to the next step in the overall set of steps. (The walk is over.)
		return -1;
	}
	
	# If the current outlinee is null.
	elsif (!defined $context->{current_outlinee})
	{
		# Do nothing.
	}
	
	# When entering a heading content element
	elsif ($type eq 'start' && is_heading_content($node, $context->{page}))
	{
		# If the current section has no heading, let the element being entered be
		#     the heading for the current section.
		if (!defined $context->{current_section}->{header})
		{
			$context->{current_section}->{header}  = $node;
			$context->{current_section}->{heading} = Swignition::GenericParser::Utils::STRINGIFY($node);
		}
			
		# Otherwise, if the element being entered has a rank equal to or greater
		#     than the heading of the last section of the outline of the current
		#     outlinee, then create a new section and append it to the outline of
		#     the current outlinee element, so that this new section is the new
		#     last section of that outline. Let current section be that new
		#     section. Let the element being entered be the new heading for the
		#     current section.
		elsif (rank_of($node) >= rank_of($context->{outlines}->{ k($context->{current_outlinee}) }->{sections}->[-1]->{header}))
		{
			$context->{current_section} = {
				thing    => 'section',
				header   => $node,
				heading  => Swignition::GenericParser::Utils::STRINGIFY($node),
				parent   => undef,
				elements => []
			};
			push @{ $context->{outlines}->{ k($context->{current_outlinee}) }->{sections} },
				$context->{current_section};
		}

		# Otherwise, run these substeps:
		else
		{
			# Let candidate section be current section.
			my $candidate = $context->{current_section};
			
			while (1)
			{
				# If the element being entered has a rank lower than the rank of
				#     the heading of the candidate section, then create a new
				#     section, and append it to candidate section. (This does not
				#     change which section is the last section in the outline.)
				#     Let current section be this new section. Let the element
				#     being entered be the new heading for the current section.
				#     Abort these substeps.
				if (rank_of($node) < rank_of($candidate->{header}))
				{
					$context->{current_section} = {
						thing    => 'section',
						header   => $node,
						heading  => Swignition::GenericParser::Utils::STRINGIFY($node),
						parent   => $candidate,
						elements => []
					};
					push @{ $candidate->{sections} }, $context->{current_section};
					last;
				}
				
				# Let new candidate section be the section that contains candidate
				#     section in the outline of current outlinee.
				# Let candidate section be new candidate section.
				$candidate = $candidate->{parent};
			}
			
			# Push the element being entered onto the stack. (This causes the
			#     algorithm to skip any descendants of the element.)
			push @{ $context->{stack} }, $node;
		}
		
	}
	
	# Otherwise
	else
	{
		# Do nothing.
	}
	
	# In addition, whenever you exit a node, after doing the steps above, if
	#     current section is not null, associate the node with the section 
	#     current section.
	if ($type eq 'end' && $context->{current_section})
	{
		push @{ $context->{current_section}->{elements} }, $node;
	}
	
	return 1; # continue
}


sub is_sectioning_content
{
	my $node = shift;
	my $page = shift;
	return 0 unless ($node->nodeType==XML_ELEMENT_NODE);

	my @bodies = $page->{DOM}->getElementsByTagName('body');
	if ( @bodies && $node->tagName =~ /^(body|section|nav|article|aside)$/i )
		{ return 1; }

	# The tagsoup parser doesn't add in BODY elements when they're missing
	# from the markup, so if there is no <body> element found, treat <html>
	# as a sectioning element instead.
	elsif ( (!@bodies) && $node->tagName =~ /^(html|section|nav|article|aside)$/i )
		{ return 1; }
		
	return 0;
}

sub is_sectioning_root
{
	my $node = shift;
	my $page = shift;
	return 0 unless ($node->nodeType==XML_ELEMENT_NODE);

	if ( $node->tagName =~ /^(blockquote|figure|td|datagrid|th)$/i )
		{ return 1; }
	
	# Support for figure microformat
	elsif ($node->getAttribute('class') =~ /\bfigure\b/)
		{ return 1; }
	
	# Support for XOXO
	elsif ($node->tagName =~ /^(ul|li)$/i && $node->getAttribute('class') =~ /\bxoxo\b/)
		{ return 1; }

	return 0;
}

sub is_heading_content
{
	my $node = shift;
	my $page = shift;
	return 0 unless ($node->nodeType==XML_ELEMENT_NODE);

	if ( $node->tagName =~ /^(h[1-6]|h|heading)$/i )
		{ return 1; }
	# Perhaps add <caption>?
	return 0;
}

# Recall that h1 has the highest rank, and h6 has the lowest rank.
sub rank_of
{
	my $node = shift;
	return 0 unless ($node->nodeType==XML_ELEMENT_NODE);
	
	if ( $node->tagName =~ /^h([1-6])$/i )
		{ return 0 - $1; }
	if ( $node->tagName =~ /^h$/i )
		{ return 1; }
	if ( $node->tagName =~ /^header$/i )
	{
		foreach my $c ($node->getElementsByTagName('*'))
			{ return rank_of($c) if (is_heading_content($c)); }
		return 1;
	}
	# Perhaps add <caption> = -7?
	return 0;
}

sub k
{
	my $node = shift;
	return '/html/body' unless ($node);
	if ($node->nodeType==XML_ELEMENT_NODE && length $node->getAttribute('_xpath'))
		{ return $node->getAttribute('_xpath'); }
	return $node->nodePath();
}


sub context_to_rdf
{
	my $page     = shift;
	my $page_url = $page->uri;
	my $page_rdf = $page->{RDF}->{$page_url};
	
	my $context  = shift;
	
	$page->mergeNS('sect',
		'http://buzzword.org.uk/rdf/sections#',
		'Sections Supplementary Terms');
	$page->mergeNS('dcterms',
		'http://purl.org/dc/terms/',
		'Dublin Core Terms');
	
	my $outline     = $context->{primary_outline};
	my $outline_url = outline_to_rdf($page, $outline);

	$page_rdf->addVal(
		'http://purl.org/dc/terms/hasPart',
		Swignition::RDFModel::Value->new($outline_url, 1)
	) unless ($outline_url eq $page_url);
}


sub outline_to_rdf
{
	my $page     = shift;
	my $page_url = $page->uri;
	my $page_rdf = $page->{RDF}->{$page_url};

	my $outline     = shift;

	my $rdf_type = 'http://purl.org/dc/dcmitype/Text';
	my $bnode_pfx = 'Section';
	if ($outline->{tagname} eq 'blockquote')
	{
		$bnode_pfx = 'Quotation';
	}
	elsif ($outline->{tagname} eq 'figure'
	||  $outline->{element}->getAttribute('class') =~ /\bfigure\b/)
	{
		$bnode_pfx = 'Figure';
		$rdf_type = 'http://purl.org/dc/dcmitype/Image';
	}
	elsif ($outline->{tagname} =~ /^(ul|ol)$/i
	&&  $outline->{element}->getAttribute('class') =~ /\bxoxo\b/)
	{
		$bnode_pfx = 'List';
		$rdf_type = 'http://purl.org/dc/dcmitype/Dataset';
	}

	my $outline_url = ($outline->{element}->tagName =~ /^(body|html)$/i) 
	                ? $page->uri
						 : ((length $outline->{element}->getAttribute('id'))
							? $page->uri.'#'.$outline->{element}->getAttribute('id')
							: Swignition::GenericParser::Utils::BNodeURI($outline->{element}, $bnode_pfx));
	my $outline_rdf = Swignition::RDFModel::Subject->new($outline_url);
		
	$outline_rdf->addVal(
		'http://buzzword.org.uk/rdf/sections#rootTag',
		Swignition::RDFModel::Value->new('http://buzzword.org.uk/rdf/xhtml-elements#'.lc($outline->{tagname}), 1)
	) unless ($outline->{tagname} =~ /^(body|html)$/i);
	
	$outline_rdf->addVal(
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#type',
		Swignition::RDFModel::Value->new($rdf_type, 1)
	);
	
	foreach my $section (@{$outline->{sections}})
	{
		my $section_url = section_to_rdf($page, $section);
		$outline_rdf->addVal(
			'http://purl.org/dc/terms/hasPart',
			Swignition::RDFModel::Value->new($section_url, 1)
		) if ($section_url);
	}
	
	$page->mergeSubject($outline_rdf);
	return $outline_url;
}


sub section_to_rdf
{
	my $page     = shift;
	my $page_url = $page->uri;
	my $page_rdf = $page->{RDF}->{$page_url};

	my $section     = shift;
	my $section_url = shift
		|| Swignition::GenericParser::Utils::BNodeURI(undef, 'Section');
		
	my $section_rdf = Swignition::RDFModel::Subject->new($section_url);
	my $header_url = shift
						|| (defined $section->{header})
							? ((length $section->{header}->getAttribute('id'))
								? $page->uri.'#'.$section->{header}->getAttribute('id')
								: Swignition::GenericParser::Utils::BNodeURI(undef, 'Header'))
							: Swignition::GenericParser::Utils::BNodeURI(undef, 'Header');
	
	$section_rdf->addVal(
		'http://purl.org/dc/terms/title',
		Swignition::RDFModel::Value->new($section->{heading})
	) if (length $section->{heading});

	$section_rdf->addVal(
		'http://buzzword.org.uk/rdf/sections#headingTag',
		Swignition::RDFModel::Value->new('http://buzzword.org.uk/rdf/xhtml-elements#'.lc($section->{header}->tagName), 1)
	) if ($section->{header});

	$section_rdf->addVal(
		'http://buzzword.org.uk/rdf/sections#heading',
		Swignition::RDFModel::Value->new($header_url, 1)
	) if ($header_url && ($header_url !~ /^bnode\:/));

	$section_rdf->addVal(
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#type',
		Swignition::RDFModel::Value->new('http://purl.org/dc/dcmitype/Text', 1)
	);
	
	foreach my $child (@{$section->{sections}})
	{
		my $child_url = section_to_rdf($page, $child);
		$section_rdf->addVal(
			'http://purl.org/dc/terms/hasPart',
			Swignition::RDFModel::Value->new($child_url, 1)
		);
	}

	foreach my $e (@{$section->{elements}})
	{
		my $E = k($e);
		if ($page->{Outlines}->{outlines}->{$E})
		{
			my $Eurl = outline_to_rdf($page, $page->{Outlines}->{outlines}->{$E});
			$section_rdf->addVal(
				'http://purl.org/dc/terms/hasPart',
				Swignition::RDFModel::Value->new($Eurl, 1)
			);
		}
	}

	if ($section->{heading} || defined $section->{sections}->[0])
	{
		$page->mergeSubject($section_rdf);
		return $section_url;
	}
	
	return;
}


1;
